signature TRANSLATE =
sig
    type level
    type access			(* not the same as FRAME.access *)

    datatype exp = Ex of Tree.exp
		 | Nx of Tree.stm
		 | Cx of Temp.label * Temp.label -> Tree.stm

    val outermost : level
    val newLevel : {parent : level, name : Temp.label, formals : bool list} -> level
    val formals : level -> access list
    val allocLocal : level -> bool -> access
    val walkStatic : level * level -> Tree.exp
    val offset : Tree.exp * int -> Tree.exp
    val index : Tree.exp * Tree.exp -> Tree.exp
    val genAccess : access * level -> Tree.exp
    val addStatic : level * level * Tree.exp list -> Tree.exp list
				      
    val unEx : exp -> Tree.exp
    val unNx : exp -> Tree.stm
    val unCx : exp -> (Temp.label * Temp.label) -> Tree.stm

    type frag
    val initResult : unit -> unit
    structure Frame : FRAME
    val getResult : unit -> frag list
    val registerString : Temp.label * string -> unit
    val registerProc : level * Tree.stm -> unit
    val externalCall : string * Tree.exp list -> Tree.exp
    val retVal : Tree.exp
end

structure Translate : TRANSLATE =
struct
  structure A = Absyn
  structure E = ErrorMsg
  structure F = MipsFrame
  structure M = Temp
  structure R = Tree

  datatype level = Outermost of F.frame
		 | FunLevel of {frame: F.frame, parent: level, unique : unit ref}

  type access = level * F.access

  fun newLevel {parent, name, formals} = FunLevel {frame = F.newFrame {name = name,
								       formals = true::formals},
						   parent = parent,
						   unique = ref ()}
					 
  val outermost = Outermost (F.newFrame {name = M.namedlabel "tigermain",
					 formals = []})

  fun formals (Outermost _) = []
    | formals (level as FunLevel{frame,parent,unique}) = map (fn a => (level, a)) (F.formals frame)

  fun allocLocal (level as Outermost f) escape = (level, F.allocLocal f escape)
    | allocLocal (level as FunLevel{frame,parent,unique}) escape = (level, F.allocLocal frame escape)

  fun walkStatic (Outermost _,                                   Outermost _)                       = R.TEMP F.FP
    | walkStatic (_,                                             Outermost _)                       = E.impossible "STATIC LINKAGE INCONSISTENCY"
    | walkStatic (level as Outermost _,                          FunLevel {frame,parent,unique})    = F.exp (F.staticLink frame) (walkStatic (level, parent))
    | walkStatic (level as FunLevel {frame=_,parent=_,unique=u}, FunLevel {frame,parent,unique=u'}) = if u=u'
												      then R.TEMP F.FP
												      else F.exp (F.staticLink frame) (walkStatic (level, parent))

  fun offset (p, n ) = R.MEM (R.BINOP (R.PLUS, p, R.CONST (n * F.wordSize)))
  fun index (a, e) = R.MEM (R.BINOP (R.PLUS, a, R.BINOP (R.MUL, e, R.CONST F.wordSize)))

  fun genAccess ((level', access), level) = F.exp access (walkStatic (level', level))

  fun addStatic(Outermost _,                    level, exps) = exps
    | addStatic(FunLevel {frame,parent,unique}, level, exps) = (walkStatic (parent, level)) :: exps

  datatype exp = Ex of R.exp
	       | Nx of R.stm
	       | Cx of M.label * M.label -> R.stm

  fun unEx (Ex e) = e
    | unEx (Cx genstm) = let val r = M.newtemp ()
			     val t = M.newlabel ()
			     val f = M.newlabel ()
			 in R.eseq ([           R.MOVE (R.TEMP r, R.ONE),
						genstm (t, f),
				     R.LABEL f, R.MOVE (R.TEMP r, R.ZERO),
				     R.LABEL t ],
				    R.TEMP r)
			 end
    | unEx (Nx s) = R.ESEQ (s, R.ZERO)


  fun unNx (Ex (R.ESEQ (s, e))) = R.SEQ (s, R.EXP e)
    | unNx (Ex e) = R.EXP e
    | unNx (Nx s) = s
    | unNx (Cx genstm) = let val l = M.newlabel ()
			 in R.SEQ (genstm (l, l),
				   R.LABEL l)
			 end

  fun unCx (Ex (R.CONST 0)) = (fn (_, f) => R.jump f)
    | unCx (Ex (R.CONST 1)) = (fn (t, _) => R.jump t)
    | unCx (Ex e) = (fn (t, f) => R.CJUMP (R.EQ, e, R.ZERO, f, t))
    | unCx (Nx s) = E.impossible "STMT TO COND"
    | unCx (Cx genstm) = genstm

  (* fragments *)
  structure Frame = F
  type frag = F.frag

  val frags : frag list ref = ref []
			      
  fun addFrag f = frags := f :: !frags

  fun initResult () = frags := []

  fun getResult () = !frags

  fun registerString (label, str) = addFrag (F.STRING (label, str))
  fun registerProc (level, stm) = let val frame = case level
						   of Outermost frame => frame
						    | FunLevel {frame, parent, unique} => frame
				  in addFrag (F.PROC { body = F.procEntryExit1 (frame, stm)
						     , frame = frame })
				  end

  val externalCall = F.externalCall

  val retVal = R.TEMP F.RV
end
